 ! Dynamic link library function for TASACS fortran modules
 ! This is the TASACS external interface for the windows world,
 ! letting you start the TASACS subroutines from i.e. delphi, c++, VBA etc.
 ! The DLL should further be packed into a component technology as activeX, to
 ! get seamless integration of fortran into clients. This layer is put outside the dll.
 ! Alternatively, compile with TASACS.f90 to make an exe file to run the console.
 ! Fortran dlls can be compiled with i.e. Lahey with -dll option.
 ! At unix you will only be able to watch it the old way through a system console.
 ! If you are using unix, you must omit this file and compile TASACS.f90 instead.

!function get_error_()
!   use error
!   character(len=255) :: get_error_
!   dll_export get_error_
!   get_error_ = g_Error
!end function get_error_

module XTASACS
   use OptimisationTypes
   implicit none
   type(TOptimisation), save :: Opt
   ! External Commands
   integer, parameter :: cmdCloseRun = 0
   integer, parameter :: cmdRunOpt = 1
   integer, parameter :: cmdResetOpt = 2
end module XTASACS


!subroutine test_dll_(update)
!   implicit none
!   dll_export test_dll_
!   integer :: intPCT
!   interface
!      subroutine update(i1)
!!         integer :: i1
!      end subroutine update
!   end interface
!   intPCT = 1
!   call update(intPCT)
!   intPCT = 2
!   call update(intPCT)
!end subroutine test_dll_


!subroutine Optimise_(OnRoundFinished)
!   use XTASACS
!   use Optimisation
!   implicit none
!   interface
!      subroutine OnRoundFinished()
!      end subroutine OnRoundFinished
!   end interface
!   dll_export Optimise_
!   call LoadRun(Opt)
!   call ManOpt(Opt, OnRoundFinished)
!   call CloseRun(Opt)
!end subroutine Optimise_


!function get_IndexInput_()
!   use XTASACS
!   use Optimisation
!   implicit none
!   type(TIndexInput), pointer :: get_IndexInput_
!   dll_export get_IndexInput_!!

   !if (.not. associated(Opt%IndexInput)) then
   !   allocate(Opt%IndexInput)
   !end if
   !get_IndexInput_ => Opt%IndexInput

!end function get_IndexInput_


subroutine RunOpt_(Value)
   use XTASACS
   use Optimisation
   implicit none
   logical :: Value
!   interface
!      subroutine CallBackFunc()
!      end subroutine CallBackFunc
!   end interface
   dll_export RunOpt_
   Value = RunOpt(Opt)
end subroutine RunOpt_


subroutine ObjFunc_(Value)
   use XTASACS
   use Optimisation
   implicit none
   double precision :: Value
!   interface
!      subroutine CallBackFunc()
!      end subroutine CallBackFunc
!   end interface
   dll_export ObjFunc_
   Value = objfunc(Opt, .false.)
end subroutine ObjFunc_



!subroutine OnOptimisationFinished_()
!   use XTASACS
!   use Optimisation
!   implicit none
!   dll_export OnOptimisationFinished_
!   call OnOptimisationFinished(Opt)
!end subroutine OnOptimisationFinished_


subroutine Execute_(CmdId, Param1)
   use XTASACS
   use Optimisation
   use Bootstrap
   implicit none
   integer, intent(in) :: CmdId
   integer, intent(in) :: Param1
   dll_export Execute_
   select case(CmdId)
      case (cmdCloseRun)
         call CloseRun(Opt)
      case (cmdResetOpt)
         call ResetOpt(Opt)
   end select
end subroutine Execute_


subroutine LoadRun_(ProjectDir, RunName)
   use XTASACS
   use index
   use Optimisation
   implicit none
   character(len=256), intent(in) :: ProjectDir
   character(len=256), intent(in) :: RunName
   logical :: res
   dll_export LoadRun_
!   call MessageOut("")
   Opt%ProjectDir = ProjectDir
   Opt%RunName = RunName
   res = LoadRun(Opt) 
end subroutine LoadRun_


subroutine CreateNewProject_(ProjectDir, FirstYear, LastYear, FirstAge, LastAge, NumFleets, NumSSB, NumBiomass)
   use XTASACS
   use index
   use Optimisation
   implicit none
   character(len=256), intent(in) :: ProjectDir
   integer :: FirstYear, LastYear, FirstAge, LastAge, NumFleets, NumSSB, NumBiomass
   dll_export CreateNewProject_
!   call MessageOut("")
   Opt%ProjectDir = ProjectDir
   Opt%RunName = "Working run"
   call CreateNewProject(Opt, FirstYear, LastYear, FirstAge, LastAge, NumFleets, NumSSB, NumBiomass) 
end subroutine CreateNewProject_


subroutine SaveRun_()
   use XTASACS
   use index
   use obsdata
   use ObjFunction
   use parameter
   implicit none
!   integer :: v
   dll_export SaveRun_
   call WriteIndexData(Opt)
   call InitializeDerivedParameters(Opt)

   call SaveParameters(Opt, .false.)
!   do v = odCaNum, odNatMort
!      call WriteYearAgeInput(v)
!   end do
end subroutine SaveRun_


subroutine get_categoryname_(Cat, Res)
   use XTASACS
   use parameter
   use strutils
   implicit none
   integer, intent(in) :: Cat
   character(len=255), intent(out) :: Res
   dll_export get_categoryname_
   if ((cFirstCategory <= Cat) .and. (Cat <= cLastCategory)) then
      Res = lrtrim(c_MetaParamSetup(Cat)%Text)
   else
      write (Res, *) Cat, " not supported"
   endif
end subroutine get_categoryname_


!function get_FirstIndex_()
!   use XTASACS
!   use index
!   implicit none
!   integer :: get_FirstIndex_
!   dll_export get_FirstIndex_
!   get_FirstIndex_ = FirstIndex()
!end function get_FirstIndex_


!function get_NumYears_()
!   use XTASACS
!   use index
!   implicit none
!   integer :: get_NumYears_
!   dll_export get_NumYears_
!   get_NumYears_ = NumYears(Opt%IndexInput)
!end function get_NumYears_


!function get_NumAges_()
!   use XTASACS
!   use index
!   implicit none
!   integer :: get_NumAges_
!   dll_export get_NumAges_
!   get_NumAges_ = NumAges(Opt%IndexInput)
!end function get_NumAges_


!function get_ParamElm_(Cat, Index, Year, Age)
!   use XTASACS
!   use parameter
!   implicit none
!   type(TParamElm), pointer :: get_ParamElm_
!   integer :: Cat, Index, Year, Age
!   dll_export get_ParamElm_
!   get_ParamElm_ => GetParamElm(Opt, Cat, Index, Year, Age, .true.)
!end function get_ParamElm_


! ------------------------------------
! Index input 


subroutine get_IndexInput_StockTitle(StockTitle)
   use XTASACS
   implicit none
   character(len = 256) :: StockTitle
   dll_export get_IndexInput_StockTitle
   StockTitle = Opt%IndexInput%StockTitle
end subroutine get_IndexInput_StockTitle


subroutine set_IndexInput_StockTitle(StockTitle)
   use XTASACS
   implicit none
   character(len = 256) :: StockTitle
   dll_export set_IndexInput_StockTitle
   Opt%IndexInput%StockTitle = StockTitle
end subroutine set_IndexInput_StockTitle


subroutine get_Run_Prop(Prop, RetVal)
   use XTASACS
   use index
   implicit none
   integer, intent(in) :: Prop
   double precision, intent(out) :: RetVal
   dll_export get_Run_Prop
   select case(Prop)
      case(propProcessType) 
         RetVal = Opt%IndexInput%ProcessType
      case(propSearchRoutine) 
         RetVal = Opt%IndexInput%SearchRoutine
      case(propModelType) 
         RetVal = Opt%IndexInput%ModelType
      case(propISVPAControlType) 
         RetVal = Opt%IndexInput%ISVPAControlType
      case(propPlusGroupMethod) 
         RetVal = Opt%IndexInput%PlusGroupMethod
      case(propFirstYear) 
         RetVal = Opt%IndexInput%FirstYear
      case(propLastYear) 
         RetVal = Opt%IndexInput%LastYear
      case(propLastCatchYear) 
         RetVal = Opt%IndexInput%LastCatchYear
      case(propFirstAge) 
         RetVal = Opt%IndexInput%FirstAge
      case(propLastAge) 
         RetVal = Opt%IndexInput%LastAge
      case(propFirstRefAge) 
         RetVal = Opt%IndexInput%FirstRefAge
      case(propLastRefAge) 
         RetVal = Opt%IndexInput%LastRefAge
      case(propNumMedianElms) 
         RetVal = Opt%IndexInput%NumMedianElms
      case(propGammaShape) 
         RetVal = 0.0d0
      case(propNumFleetIndices) 
         RetVal = NumFleetIndices(Opt%IndexInput)
      case(propNumSSBIndices) 
         RetVal = NumSSBIndices(Opt%IndexInput)
      case(propNumBiomassIndices) 
         RetVal = NumBiomassIndices(Opt%IndexInput)
      case(propNumStages) 
         RetVal = Opt%IndexInput%NumStages
      case(propSSBFracF) 
         RetVal = Opt%IndexInput%SSBFracF
      case(propSSBFracM) 
         RetVal = Opt%IndexInput%SSBFracM
      case(propRunStage) 
         RetVal = Opt%Loc%Stage
      case(propRunIter) 
         RetVal = Opt%Loc%Iter
      case(propRunDelta) 
         RetVal = Opt%Loc%Delta
      case(propRunObjFunc) 
         RetVal = Opt%Loc%ObjFunc
      case(propRunNumParam)
         RetVal = size(Opt%pactive)
      case(propProgramVersion)
         RetVal = 1.1d0
      case default
         RetVal = 0d0
   end select
end subroutine get_Run_Prop


subroutine set_Run_Prop(Prop, Value)
   use XTASACS
   use index
   implicit none
   integer :: Prop, DataSourceType, S
   double precision ::  Value
   dll_export set_Run_Prop
   select case(Prop)
      case(propProcessType) 
         Opt%IndexInput%ProcessType = anint(Value)
      case(propSearchRoutine) 
         Opt%IndexInput%SearchRoutine = anint(Value)
      case(propModelType) 
         Opt%IndexInput%ModelType = anint(Value)
      case(propISVPAControlType) 
         Opt%IndexInput%ISVPAControlType = anint(Value)
      case(propPlusGroupMethod) 
         Opt%IndexInput%PlusGroupMethod = anint(Value)
      case(propFirstYear) 
         Opt%IndexInput%FirstYear = anint(Value)
      case(propLastYear) 
         Opt%IndexInput%LastYear = anint(Value)
      case(propLastCatchYear) 
         Opt%IndexInput%LastCatchYear = anint(Value)
      case(propFirstAge) 
         Opt%IndexInput%FirstAge = anint(Value)
      case(propLastAge) 
         Opt%IndexInput%LastAge = anint(Value)
      case(propFirstRefAge) 
         Opt%IndexInput%FirstRefAge = anint(Value)
      case(propLastRefAge) 
         Opt%IndexInput%LastRefAge = anint(Value)
      case(propNumMedianElms) 
         Opt%IndexInput%NumMedianElms = anint(Value)
      case(propGammaShape) 
         ;
      case(propNumFleetIndices, propNumSSBIndices, propNumBiomassIndices) 
         DataSourceType = Prop - propNumFleetIndices + 1 
         S = size(Opt%IndexInput%DataSources(DataSourceType)%Elm)
         if (S /= anint(Value)) then
            ! Reallocate
            if(associated(Opt%IndexInput%DataSources(DataSourceType)%Elm)) then
               deallocate(Opt%IndexInput%DataSources(DataSourceType)%Elm)
            endif
            allocate(Opt%IndexInput%DataSources(DataSourceType)%Elm(0 : anint(Value) - 1))
         endif
      case(propNumStages) 
         Opt%IndexInput%NumStages = anint(Value)
      case(propSSBFracF) 
         Opt%IndexInput%SSBFracF = Value
      case(propSSBFracM) 
         Opt%IndexInput%SSBFracM = Value
      case(propRunStage) 
         Opt%Loc%Stage = anint(Value)
   end select
end subroutine set_Run_Prop


subroutine get_Run_Prop_Str(Prop, RetVal)
   use XTASACS
   use index
   implicit none
   integer, intent(in) :: Prop
   character(len = 256), intent(out) :: RetVal
   dll_export get_Run_Prop_Str
   select case(Prop)
      case(propCaTonFile : propBiomassWeightFile)
         RetVal = Opt%IndexInput%DataFiles(odCaTon + (Prop - propCaTonFile))
      case(propParamIn) 
         RetVal = Opt%IndexInput%InParamFileName
      case(propParamOutFile : propRetroRecruitFile)
         RetVal = Opt%IndexInput%OutFiles(roParamOut + (Prop - propParamOutFile))
      case(propErrorStr)
         RetVal = Opt%ErrorStr
      case(propRunErrorStr)
         RetVal = Opt%RunErrorStr
   end select
end subroutine get_Run_Prop_Str


subroutine set_Run_Prop_Str(Prop, Value)
   use XTASACS
   use index
   implicit none
   integer :: Prop
   character(len = 256) ::  Value
   dll_export set_Run_Prop_Str
   select case(Prop)
      case(propCaTonFile : propBiomassWeightFile)
         Opt%IndexInput%DataFiles(odCaTon + (Prop - propCaTonFile)) = Value
      case(propParamIn) 
         Opt%IndexInput%InParamFileName = Value
      case(propParamOutFile : propRetroRecruitFile)
         Opt%IndexInput%OutFiles(roParamOut + (Prop - propParamOutFile)) = Value
   end select
end subroutine set_Run_Prop_Str


subroutine get_DataSource(DataSource, DataSourceIndex, FProp, MProp, ObjType, Weight, My, PlusGroupCode, BootType, Sigma, BootFile)
   use XTASACS
   use ObsData
   implicit none
   integer, intent(in) :: DataSource, DataSourceIndex
   integer, intent(out) :: ObjType
   double precision, intent(out) :: FProp, MProp, Weight, My, Sigma
   integer, intent(out) :: PlusGroupCode
   integer, intent(out) :: BootType
   character(len=32), intent(out) :: BootFile
   type(TDataSource), pointer :: pDataSource
   dll_export get_DataSource
   pDataSource => GetDataSource(Opt, DataSource, DataSourceIndex)
   if (associated(pDataSource)) then
      FProp = pDataSource%FProp 
      MProp = pDataSource%MProp 
      ObjType = pDataSource%ObjType
      Weight = pDataSource%Weight
      My = pDataSource%My
      PlusGroupCode = pDataSource%PlusGroupCode
      BootType = pDataSource%BootType  
      Sigma = pDataSource%Sigma
      BootFile = pDataSource%BootFile 
   endif
end subroutine get_DataSource


subroutine set_DataSource(DataSource, DataSourceIndex, FProp, MProp, ObjType, Weight, My, PlusGroupCode, BootType, Sigma, BootFile)
   use XTASACS
   use ObsData
   implicit none
   integer, intent(in) :: DataSource, DataSourceIndex
   integer, intent(in) :: ObjType
   double precision, intent(in) :: FProp, MProp, Weight, My, Sigma
   integer, intent(in) :: PlusGroupCode
   integer, intent(in) :: BootType
   character(len=32), intent(in) :: BootFile
   type(TDataSource), pointer :: pDataSource
   dll_export set_DataSource
   pDataSource => GetDataSource(Opt, DataSource, DataSourceIndex)
   if (associated(pDataSource)) then
      pDataSource%FProp = FProp
      pDataSource%MProp = MProp 
      pDataSource%ObjType = ObjType
      pDataSource%Weight = Weight 
      pDataSource%My = My 
      pDataSource%PlusGroupCode = PlusGroupCode
      pDataSource%BootType = BootType
      pDataSource%Sigma = Sigma
      pDataSource%BootFile = BootFile
   endif
end subroutine set_DataSource

! ------------------------------------
! Parameter element


subroutine get_ParamElm_Value(Cat, Index, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   double precision :: Value
   integer :: Cat, Index, Year, Age
   type(TParamElm), pointer :: ParamElm
   dll_export get_ParamElm_Value
   ParamElm => GetParamElm(Opt, Cat, Index, Year, Age, .true.)
   if(associated(ParamElm)) then
      Value = ParamElm%Value
   endif
end subroutine get_ParamElm_Value


subroutine set_ParamElm_Value(Cat, Index, Year, Age, V)
   use XTASACS
   use parameter
   implicit none
   integer :: Cat, Index, Year, Age
   double precision :: V
   dll_export set_ParamElm_Value
   call SetPValue(Opt, Cat, Index, Year, Age, V)
end subroutine set_ParamElm_Value


subroutine get_ParamElm_Flag(Cat, Index, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Value
   integer :: Cat, Index, Year, Age
   dll_export get_ParamElm_Flag
   Value = PFlag(Opt, Cat, Index, Year, Age)
end subroutine get_ParamElm_Flag


subroutine set_ParamElm_Flag(Cat, Index, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Cat, Index, Year, Age, Value
   type(TParamElm), pointer :: ParamElm
   dll_export set_ParamElm_Flag
   ParamElm => GetParamElm(Opt, Cat, Index, Year, Age, .true.)
   if(associated(ParamElm)) then
      ParamElm%Flag = Value
   endif
end subroutine set_ParamElm_Flag


subroutine get_ParamElm_Descr(Cat, Index, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Cat, Index, Year, Age
   character(len = c_ParamElmDescrLen) :: Value
   type(TParamElm), pointer :: ParamElm
   dll_export get_ParamElm_Descr
   ParamElm => GetParamElm(Opt, Cat, Index, Year, Age, .true.)
   if(associated(ParamElm)) then
      Value = ParamElm%Descr
   endif
end subroutine get_ParamElm_Descr


subroutine set_ParamElm_Descr(Cat, Index, Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Cat, Index, Year, Age
   character(len = c_ParamElmDescrLen) :: Value
   type(TParamElm), pointer :: ParamElm
   dll_export set_ParamElm_Descr
   if(associated(ParamElm)) then
      ParamElm => GetParamElm(Opt, Cat, Index, Year, Age, .true.)
      ParamElm%Descr = Value
   endif
end subroutine set_ParamElm_Descr


subroutine get_N_(Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   double precision :: Value
   integer :: Year, Age
   dll_export get_N_
   if (associated(Opt%PopModel)) then
      Value = Opt%PopModel%Nay(Year, Age)
   end if
end subroutine get_N_


subroutine get_F_(Year, Age, Value)
   use XTASACS
   use parameter
   implicit none
   double precision :: Value
   integer :: Year, Age
   dll_export get_F_
   if (associated(Opt%PopModel)) then
      Value = Opt%PopModel%Fay(Year, Age)
   end if
end subroutine get_F_


subroutine get_ActiveParam_Value(Index, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Index
   double precision :: Value
   dll_export get_ActiveParam_Value
   Value = Opt%pactive(Index)%Value
end subroutine get_ActiveParam_Value


subroutine set_ActiveParam_Value(Index, Value)
   use XTASACS
   use parameter
   implicit none
   integer :: Index
   double precision :: Value
   dll_export set_ActiveParam_Value
   call SetPValueEx(Opt%pactive(Index), Value)
end subroutine set_ActiveParam_Value


subroutine get_DataSourceDimensions(Cat, Idx, FirstYear, LastYear, FirstAge, LastAge)
   use XTASACS
   use parameter
   implicit none
   integer, intent(in) :: Cat, Idx 
   integer, intent(out) :: FirstYear, LastYear, FirstAge, LastAge
   type(TObservedData), pointer :: pVar
   dll_export get_DataSourceDimensions
   if (.not. associated(Opt%ObservedData(Cat)%Elm)) return
   pVar => Opt%ObservedData(Cat)%Elm(Idx)
   FirstYear = pVar%FirstYear
   LastYear = pVar%FirstYear + pVar%NumYears - 1
   FirstAge = pVar%FirstAge
   if (FirstAge == -1) then
      LastAge = -1
   else
      LastAge = pVar%FirstAge + pVar%NumAges - 1
   endif
end subroutine get_DataSourceDimensions


subroutine set_DataSourceDimensions(Cat, Idx, FirstYear, LastYear, FirstAge, LastAge)
   use XTASACS
   use parameter
   use ObsData
   implicit none
   integer, intent(in) :: Cat, Idx, FirstYear, LastYear, FirstAge, LastAge
   integer :: Num_Years, Num_Ages, NAges, NYears
   type(TObservedData), pointer :: pVar
   double precision, pointer :: pTempObs(:,:)
   
   logical :: DimChanged
   logical :: OnlyChangedEnd
   dll_export set_DataSourceDimensions
   pVar => Opt%ObservedData(Cat)%Elm(Idx)
   Num_Years = LastYear - FirstYear + 1
   Num_Ages = LastAge - FirstAge + 1 
   allocate(pTempObs(0 : pVar%NumYears - 1,  0 : pVar%NumAges - 1))
   pTempObs(0 : pVar%NumYears - 1,  0 : pVar%NumAges - 1) = pVar%Obs(0 : pVar%NumYears - 1,  0 : pVar%NumAges - 1)
   OnlyChangedEnd = &
      ((pVar%FirstYear == FirstYear) .and. &
      (pVar%FirstAge == FirstAge)) .and. &
      ((pVar%NumYears /=  Num_Years) .or. &
      (pVar%NumAges /=  Num_Ages))
   DimChanged = &
      (pVar%FirstYear /= FirstYear) .or. &
      (pVar%NumYears /=  Num_Years) .or. &
      (pVar%FirstAge /= FirstAge) .or. &
      (pVar%NumAges /=  Num_Ages)
   pVar%FirstYear = FirstYear
   pVar%NumYears =  Num_Years
   pVar%FirstAge = FirstAge 
   pVar%NumAges = Num_Ages
   if (DimChanged) then
      pVar%FirstYear = FirstYear
      pVar%NumYears =  Num_Years
      pVar%FirstAge = FirstAge 
      pVar%NumAges = Num_Ages
      call AllocateObservedData(pVar)
      if(OnlyChangedEnd) then
         pVar%Obs(0 : pVar%NumYears - 1,  0 : pVar%NumAges - 1) = 1.0d0 ! default 1
         NAges = min(pVar%NumAges, size(pTempObs, 2)); 
         NYears = min(pVar%NumYears, size(pTempObs, 1));
         pVar%Obs(0 : NYears - 1,  0 : NAges - 1) = pTempObs(0 : NYears - 1,  0 : NAges - 1)
      endif
   endif
   deallocate(pTempObs);
end subroutine set_DataSourceDimensions


subroutine get_DataSourceValue(Cat, Idx, iYear, iAge, Value)
   use XTASACS
   use parameter
   implicit none
   integer, intent(in) :: Cat, Idx, iYear, iAge
   double precision, intent(out) :: Value
   type(TObservedData), pointer :: pVar
   dll_export get_DataSourceValue
   pVar => Opt%ObservedData(Cat)%Elm(Idx)
   Value = pVar%Obs(iYear, iAge)
end subroutine get_DataSourceValue


subroutine set_DataSourceValue(Cat, Idx, iYear, iAge, Value)
   use XTASACS
   use parameter
   implicit none
   integer, intent(in) :: Cat, Idx, iYear, iAge
   double precision, intent(in) :: Value
   type(TObservedData), pointer :: pVar
   dll_export set_DataSourceValue
   pVar => Opt%ObservedData(Cat)%Elm(Idx)
   pVar%Obs(iYear, iAge) = Value
end subroutine set_DataSourceValue


subroutine SaveObsData()
   use XTASACS
   use ObsData
   implicit none
   dll_export SaveObsData
   call WriteObsData(Opt)
end subroutine SaveObsData

